home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / toolkit / riruf1 / rufmain.bas < prev    next >
BASIC Source File  |  1995-05-19  |  2KB  |  99 lines
  1. Option Explicit
  2. Global Const TheAppTitle$ = "Reusable Functions Demo"
  3. 'Global sDBPath$
  4. Global Const sDBName$ = "rufdemo.mdb"
  5.  
  6. 'RufAbout form variables
  7. Global bReg% 'Registered version flag
  8. Global Const sVer$ = "1.00" 'version number
  9.  
  10. Function LoadText$ (sFileName$)
  11.     On Error GoTo TextErr
  12.     Dim sLine$, sInfo$
  13.  
  14.     HourglassCursor
  15.     If StrComp(sFileName, "") <> 0 Then
  16.         Open sFileName For Input As 1
  17.         If LOF(1) > 32000 Then
  18.             ArrowCursor
  19.             StopUser "File is larger than 32K!"
  20.             Close 1
  21.             Exit Function
  22.         End If
  23.         Line Input #1, sLine
  24.         While Not EOF(1)
  25.             sInfo = sInfo & sLine + Chr(13) + Chr(10)
  26.             Line Input #1, sLine
  27.         Wend
  28.         sInfo = sInfo & sLine + Chr(13) + Chr(10)
  29.         Close 1
  30.     End If
  31.     ArrowCursor
  32.     LoadText = sInfo
  33.     Exit Function
  34.  
  35. TextErr:
  36.     If Err <> 53 Then
  37.         ArrowCursor
  38.         GetErrorMsg Err
  39.     Else
  40.         LoadText = ""
  41.     End If
  42.     Exit Function
  43. End Function
  44.  
  45. Sub OpenDB ()
  46.     On Error GoTo dbErr
  47.     Dim x%, bDBOK%
  48.  
  49.     'get path from .ini file
  50.     If Len(RTrim$(sDBPath)) < 2 Then
  51.         bDBOK = True
  52.         GoTo showform
  53.     End If
  54.  
  55.     If Len(RTrim$(sDBPath)) < Len(sDBName) Then
  56.         StopUser "Invalid path or database name!"
  57.         ModalForm RUFDBForm
  58.     End If
  59.  
  60.     If InStr(1, sDBPath, sDBName, 1) = 0 Then
  61.         StopUser "Incorrect database name!"
  62.         bDBOK = True
  63.         GoTo showform
  64.         'Exit Sub
  65.     End If
  66.  
  67.     HourglassCursor
  68.     Set TheDatabase = OpenDatabase(sDBPath)
  69.     ArrowCursor
  70.  
  71.     'keep loading dbForm till the database is open
  72. showform:
  73.     While bDBOK
  74.     bDBOK = False
  75.     bRufDbEnd = True
  76.     ModalForm RUFDBForm
  77.  
  78.     If InStr(1, sDBPath, sDBName, 1) = 0 Then
  79.         StopUser "Incorrect database name!"
  80.         bDBOK = True
  81.         GoTo showform
  82.     End If
  83.     HourglassCursor
  84.     Set TheDatabase = OpenDatabase(sDBPath)
  85.     ArrowCursor
  86.     Wend
  87.  
  88.     'write the new path
  89.     WriteToIni "Database", sDBPath
  90.     Exit Sub
  91.  
  92. dbErr:
  93.     bDBOK = True
  94.     DatabaseError
  95.     Resume Next
  96.  
  97. End Sub
  98.  
  99.